home *** CD-ROM | disk | FTP | other *** search
/ Aminet 22 / Aminet 22 (1997)(GTI - Schatztruhe)[!][Dec 1997].iso / Aminet / dev / misc / gms_e.lha / GMSDev / Source / E / Demos / Kohonen.e < prev   
Text File  |  1997-09-15  |  4KB  |  162 lines
  1. /* Kohonen Feature Maps in E, implemented with integers
  2. **
  3. ** Kohonen feature maps are special types of neural nets, and
  4. ** this implementation shows graphically how they organise themselves
  5. ** after a while.
  6. **
  7. ** [This demo from the AmigaE archives has been converted to work with GMS.
  8. ** It is at about 33% faster than the original intuition version.]
  9. */
  10.  
  11. CONST ONE     = 1024*16,   KSHIFT = 14,      KSIZE  = 7,
  12.       MAXTIME = 500,       DELAY  = 0,       YOFF   = 20
  13. CONST KSTEP   = ONE/KSIZE, KNODES = KSIZE+1, ARSIZE = KSIZE*KSIZE,
  14.       XRED    = 64,        YRED   = 128,     XOFF   = 10
  15.  
  16. MODULE 'dpkernel','gms/dpkernel','graphics/pictures','files/files'
  17. MODULE 'screens','system/register','system/modules','gms/joydata'
  18. MODULE 'graphics/screens','blitter'
  19.  
  20. /*=========================================================================*/
  21.  
  22. PROC main()
  23.  DEF screen=NIL:PTR TO screen,map,t,input,x,y
  24.  DEF scrmodule=NIL:PTR TO module, bltmodule=NIL:PTR TO module
  25.  
  26.  IF dpkbase := OpenLibrary('GMS:libs/dpkernel.library',0)
  27.     SetUserPrefs(0)
  28.  
  29.   IF (scrmodule := Init([TAGS_MODULE,NIL,
  30.       MODA_NUMBER,    MOD_SCREENS,
  31.       MODA_TABLETYPE, JMP_AMIGAE,
  32.       TAGEND], NIL))
  33.       scrbase := scrmodule.modbase
  34.  
  35.   IF (bltmodule := Init([TAGS_MODULE,NIL,
  36.       MODA_NUMBER,    MOD_BLITTER,
  37.       MODA_TABLETYPE, JMP_AMIGAE,
  38.       TAGEND], NIL))
  39.       bltbase := bltmodule.modbase
  40.  
  41.     IF (screen := Init([TAGS_SCREEN,NIL,
  42.        GSA_PALETTE,   [$000000,$f0f0f0],
  43.        GSA_SCRWIDTH,  320,
  44.        GSA_SCRHEIGHT, 256,
  45.        GSA_PLANES,    2,
  46.        GSA_SCRATTRIB, DBLBUFFER OR CENTRE,
  47.        GSA_SCRMODE,   HIRES,
  48.        TAGEND],NIL))
  49.  
  50.        Display(screen)
  51.  
  52.        map := kohonen_init(KSIZE,KSIZE,2)
  53.  
  54.        FOR t := 0 TO MAXTIME-1
  55.          input := [Rnd(KNODES)*KSTEP,Rnd(KNODES)*KSTEP]
  56.          x,y   := kohonen_BMU(map,input)
  57.          kohonen_plot(map,screen,x,y)
  58.          kohonen_learn(map,x,y,MAXTIME-t*(ONE/MAXTIME),input)
  59.        ENDFOR
  60.  
  61.        WaitLMB()
  62.     ENDIF
  63.    ENDIF
  64.    ENDIF
  65.    Free(bltmodule)
  66.    Free(scrmodule)
  67.    Free(screen)
  68.    CloseDPK()
  69.  ENDIF
  70. ENDPROC
  71.  
  72. /*=========================================================================*/
  73.  
  74. PROC kohonen_plot(map,screen:PTR TO screen,bx,by)
  75. DEF x,y,n:PTR TO LONG,cx,cy,i,ii,sx[ARSIZE]:ARRAY OF LONG
  76. DEF sy[ARSIZE]:ARRAY OF LONG
  77.  
  78.   ClearBitmap(screen.bitmap)
  79.   FOR x:=0 TO KSIZE-1
  80.     FOR y:=0 TO KSIZE-1
  81.       n := kohonen_node(map,x,y)
  82.       i := x*KSIZE+y
  83.       ii := x-1*KSIZE+y
  84.       sx[i] := cx := s(n[0]/XRED+XOFF)
  85.       sy[i] := cy := s(n[1]/YRED+YOFF)
  86.       IF x>0 THEN DrawLine(screen.bitmap,sx[ii],sy[ii],cx,cy,1)
  87.       IF y>0 THEN DrawLine(screen.bitmap,sx[i-1],sy[i-1],cx,cy,1)
  88.     ENDFOR
  89.   ENDFOR
  90.  
  91.   n := kohonen_node(map,bx,by)
  92.   DrawPixel(screen.bitmap,s(n[0]/XRED+XOFF),s(n[1]/YRED+YOFF),1)
  93.   WaitVBL()
  94.   SwapBuffers(screen)
  95. ENDPROC
  96.  
  97. /*=========================================================================*/
  98.  
  99. PROC s(c) IS IF c<0 THEN 0 ELSE IF c>1000 THEN 1000 ELSE c
  100.  
  101. /*=========================================================================*/
  102.  
  103. PROC kohonen_BMU(map,i:PTR TO LONG)
  104.   DEF x,y,act,bestx,besty,bestact=$FFFFFFF,n:PTR TO LONG,len,a
  105.  
  106.   len:=ListLen(i)-1
  107.   FOR x:=0 TO KSIZE-1
  108.     FOR y:=0 TO KSIZE-1
  109.       n:=kohonen_node(map,x,y)
  110.       act:=0
  111.       FOR a:=0 TO len DO act:=Abs(n[a]-i[a])+act
  112.       IF act<bestact
  113.          bestx := x
  114.          besty := y
  115.          bestact := act
  116.       ENDIF
  117.     ENDFOR
  118.   ENDFOR
  119.  
  120. ENDPROC bestx,besty
  121.  
  122. /*=========================================================================*/
  123.  
  124. PROC kohonen_learn(m,bx,by,t,i:PTR TO LONG)
  125.   DEF x,y,n:PTR TO LONG,d,a,len,bell:PTR TO LONG
  126.  
  127.   bell:=[50,49,47,40,25,13,10,8,6,5,4,3,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
  128.   len:=ListLen(i)-1
  129.  
  130.   FOR x:=0 TO KSIZE-1
  131.     FOR y:=0 TO KSIZE-1
  132.       n:=kohonen_node(m,x,y)
  133.       d:=t*bell[Abs(bx-x)+Abs(by-y)]/50      -> cityblock
  134.       IF d>0
  135.         FOR a:=0 TO len DO n[a]:=n[a]+Shr(i[a]-n[a]*d,KSHIFT)
  136.       ENDIF
  137.     ENDFOR
  138.   ENDFOR
  139. ENDPROC
  140.  
  141. /*=========================================================================*/
  142.  
  143. PROC kohonen_node(map:PTR TO LONG,x,y)
  144.   DEF r:PTR TO LONG
  145.   r:=map[x]
  146. ENDPROC r[y]
  147.  
  148. /*=========================================================================*/
  149.  
  150. PROC kohonen_init(numx,numy,numw)
  151. DEF m:PTR TO LONG,r:PTR TO LONG,w:PTR TO LONG,a,b,c
  152.   NEW m[numx]
  153.   FOR a:=0 TO numx-1
  154.     m[a]:=NEW r[numy]
  155.     FOR b:=0 TO numy-1
  156.       r[b]:=NEW w[numw]
  157.       FOR c:=0 TO numw-1 DO w[c]:=ONE/2
  158.     ENDFOR
  159.   ENDFOR
  160. ENDPROC m
  161.  
  162.